module Tokens
(
	lexico
) where


import Data.Char
import Tipos


reserved_words = ["PROGRAM", "END", "FUNCTION", "SUBROUTINE", "IF", "THEN", "ELSEIF", "ELSE", "WHILE", "SELECT", "CASE", "TYPE", 
                  "WRITE", "READ", "DEFINE", "RETURN", "INTEGER", "CHARACTER", "LOGICAL", "REAL", "AND", "OR", "NOT"]

-- Remove um comentario
comment str = 
    case str of
        [] -> []
        ('\n':tl) -> tl
        (a:b) -> comment b

-- Obtém uma string
get_string str = let [(a, b)] = reads str :: [(String, String)] in (String_tk a, b)

-- Obtém um char
get_char str = let [(a, b)] = reads str :: [(Char, String)] in (Char_tk a, b)

-- Obtém um número int ou float
get_number str = 
    let x = reads str :: [(Int, String)] in
    case x of
        [] -> let [(a, b)] = reads str :: [(Float, String)] in (Float_tk a, b)
        _ ->  let [(a, b)] = x in (Int_tk a, b)

-- Obtém um identificador(string)
get_id str id = 
    if Data.Char.isLetter (head str) || Data.Char.isDigit (head str) || (head str) == '_' then
        get_id (tail str) ((head str):id)
    else
        ((reverse id), str)

-- Obtém uma palavra reservada(token)
get_reserved str =
    let (a, b) = get_id str "" in
    if [x | x <- reserved_words, x == a] /= [] then
        case str of
            ('T':'R':'U':'E':tl)                         -> (Bool_tk True, tl)
            ('F':'A':'L':'S':'E':tl)                     -> (Bool_tk False, tl)
            ('P':'R':'O':'G':'R':'A':'M':tl)             -> (Program_tk, tl)
            ('E':'N':'D':tl)                             -> (End_tk, tl)
            ('F':'U':'N':'C':'T':'I':'O':'N':tl)         -> (Function_tk, tl)
            ('S':'U':'B':'R':'O':'U':'T':'I':'N':'E':tl) -> (Subroutine_tk, tl)
            ('I':'F':tl)                                 -> (If_tk, tl)
            ('A':'N':'D':tl)                             -> (And_tk, tl)
            ('O':'R':tl)                                 -> (Or_tk, tl)
            ('N':'O':'T':tl)                             -> (Not_tk, tl)
            ('T':'H':'E':'N':tl)                         -> (Then_tk, tl)
            ('E':'L':'S':'E':'I':'F':tl)                 -> (Elseif_tk, tl)
            ('E':'L':'S':'E':tl)                         -> (Else_tk, tl)
            ('W':'H':'I':'L':'E':tl)                     -> (While_tk, tl)
            ('S':'E':'L':'E':'C':'T':tl)                 -> (Select_tk, tl)
            ('C':'A':'S':'E':tl)                         -> (Case_tk, tl)
            ('D':'E':'F':'A':'U':'L':'T':tl)             -> (Logical_tk, tl)
            ('T':'Y':'p':'E':tl)                         -> (Type_tk, tl)
            ('W':'R':'I':'T':'E':tl)                     -> (Write_tk, tl)
            ('R':'E':'A':'D':tl)                         -> (Read_tk, tl)
            ('D':'E':'F':'I':'N':'E':tl)                 -> (Define_tk, tl)
            ('R':'E':'T':'U':'R':'N':tl)                 -> (Return_tk, tl)
            ('I':'N':'T':'E':'G':'E':'R':tl)             -> (Integer_tk, tl)
            ('R':'E':'A':'L':tl)                         -> (Real_tk, tl)
            ('L':'O':'G':'I':'C':'A':'L':tl)             -> (Logical_tk, tl)
            ('C':'H':'A':'R':'A':'C':'T':'E':'R':tl)     -> (Character_tk, tl)
            _ -> (Error_tk, str)
    else
        (Id_tk a, b)

get_token str
    | head str == '"'                    = let (a, b) = get_string str in a
    | head str == '\''                   = let (a, b) = get_char str in a
    | head str >= '0' && head str <= '9' = let (a, b) = get_number str in a
    | Data.Char.isLetter (head str)      = let (a, b) = get_reserved str in a
    | otherwise                          = Error_tk

off_token str
    | head str == '"'                    = let (a, b) = get_string str in b
    | head str == '\''                   = let (a, b) = get_char str in b
    | head str >= '0' && head str <= '9' = let (a, b) = get_number str in b
    | Data.Char.isLetter (head str)      = let (a, b) = get_reserved str in b
    | otherwise                          = ""

aux str line =
    case str of
        [] -> []
        ('\n':tl) -> aux tl (line + 1)
        ('\t':tl) -> aux tl line
        ('\r':tl) -> aux tl line
        (' ':tl)  -> aux tl line
        ('!':tl)  -> aux (comment str) (line + 1)
        ('+':'.':tl) -> (Concat_tk, line):(aux tl line)
        ('*':'*':tl) -> (Exp_tk, line):(aux tl line)
        ('/':'=':tl) -> (NEQ_tk, line):(aux tl line)
        ('=':'=':tl) -> (EQ_tk, line):(aux tl line)
        ('>':'=':tl) -> (GE_tk, line):(aux tl line)
        ('<':'=':tl) -> (LE_tk, line):(aux tl line)
        ('=':tl) -> (Atrib_tk, line):(aux tl line)
        ('+':tl) -> (Plus_tk, line):(aux tl line)
        ('-':tl) -> (Minus_tk, line):(aux tl line)
        ('*':tl) -> (Mult_tk, line):(aux tl line)
        ('/':tl) -> (Div_tk, line):(aux tl line)
        ('>':tl) -> (GT_tk, line):(aux tl line)
        ('<':tl) -> (LT_tk, line):(aux tl line)
        ('(':tl) -> (LP_tk, line):(aux tl line)
        (')':tl) -> (RP_tk, line):(aux tl line)
        ('.':tl) -> (PT_tk, line):(aux tl line)
        (',':tl) -> (VG_tk, line):(aux tl line)
        (';':tl) -> (PV_tk, line):(aux tl line)
        (':':tl) -> (DP_tk, line):(aux tl line)
        ('[':tl) -> (LC_tk, line):(aux tl line)
        (']':tl) -> (RC_tk, line):(aux tl line)
        (hd:tl)  -> (get_token str, line):(aux (off_token str) line)

lexico str = aux str 1

